        TITL DAI FIRMWARE 3E1F6-3E3F0  V1.0  Rev.1
        ORG   :E1F6
*
*
*
*********************
* ENCODE 'ENVELOPE' *
*********************
*
* Encodes <ENV> (<V>,<T>;) <V>,<T> or
* <ENV> (<V>,<T>;) <V>.
*
* Exit: HL points beyond expression in EBUF.
*       AFBCDE corrupted.
*
EENV    CALL  :E36D     Encode ENV nr
        PUSH  H         Preserve EBUF pntr
        CALL  :E018     Update EBUF pointer
        MVI   D,:00     Init length
L3E33   CALL  :E222     Encode <V>
        CALL  :E859     Next char ':' or 'CR' ?
        JZ    :E21E     Then ready
        CALL  :E862     Check if next char is ','
 REM run error if not
        CALL  :E222     Encode <T>
        CALL  :E867     Check if next char is ';'
        DATA  :3B
        INR   D         Length +1
        MVI   M,:FF     FF into EBUF
        CALL  :E859     Next char ':' or 'CR' ?
        JNZ   :E1FF     Again if not
        CALL  :E018     Update EBUF pointer
L3E34   XTHL
        MOV   M,D       Length in EBUF after token
        POP   H
        RET
*
* ENCODE A <V> OR <T> ELEMENT:
*
* Exit: DE preserved.
*
L3E35   PUSH  D
        CALL  :E36D     Encode INT expr
        POP   D
        RET
*
****************************
* ENCODE 'LIST' AND 'EDIT' *
****************************
*
* Checks the expression after the token and updates
* the token on it.
* On exit, the token is:
*                  EDIT     LIST
* Without linenr:   B6       93
* One line:         B7       94
* Part of program:  B8       95
*
* Entry: HL   : Points after token in EBUF.
* Exit:  C, HL: Updated.
*        D    : Token.
*        AF corrupted, BE preserved.
*
*ELIST
EEDIT   DCX   H         Pnts to token
        MOV   D,M       Token in D
        PUSH  H         Preserve EBUF pntr
        INX   H
        CALL  :E859     Next char ':' or 'CR' ?
        JZ    :E244     Then ready
        CALL  :E248     Read linenr into EBUF
        INR   D         Token +1
        CALL  :E859     Next char ':' or 'CR' ?
        JZ    :E244     Then ready
        CALL  :E867     Next char '-' ?
        DATA  :2D
        CALL  :E248     Read linenr into EBUF
        INR   D         Again token +1
L3E37   XTHL
        MOV   M,D       Token into EBUF
        POP   H
        RET
*
* READ LINENUMBER INTO EBUF:
*
* Reads a linenumber from the input line into
* the EBUF. If no linenumber is given, 0000 is
* inserted.
*
* Entry: HL: Points to 1st free location in EBUF.
*        C : Points to input line.
* Exit:  C, HL: Updated.
*        AF corrupted, BDE preserved.
*
L3E38   PUSH  D
        CALL  :E731     Read linenr into EBUF
        POP   D
        RC              Ready if nr given
        MVI   M,:00     00 into EBUF
        CALL  :E018     Update EBUF pointer
        MVI   M,:00     00 into EBUF
        CALL  :E018     Update EBUF pointer
        RET
*
*********************************************
* ENCODE 'WAIT', 'WAIT TIME' AND 'WAIT MEM' *
*********************************************
*
EWAIT   LXI   D,:E25F   Addr table
        JMP   :E09A     Get addr encoding instr
 REM and go to it
 REM
* Table:
 REM
L3E401  DATA  :04
        DATA  :54       T
        DATA  :49       I
        DATA  :4D       M
        DATA  :45       E
        DBL   :E285     Addr encode 'TIME'
*
        DATA  :03
        DATA  :4D       M
        DATA  :45       E
        DATA  :4D       M
        DBL   :E26F     Addr encode 'MEM'
*
        DATA  :00
        DBL   :E272     Addr encode 'port'
 REM
* Encode 'MEM':
 REM
L3E40   DCX   H
        INR   M         Token +1 (#91)
        INX   H
L3E412  CALL  :E302     Encode <INT expr>,<INT expr>
        MVI   M,:FF     FF into EBUF
        CALL  :E018     Update EBUF pointer
        CALL  :DDD2     Get char from line, neglect
 REM tab + space
        CPI   :2C       ',' ?
        RNZ             Ready if not
        DCX   H
        INX   B
        JMP   :E36D     Encode INT expr
 REM
* Encode 'TIME':
 REM
L3E41   DCX   H
        INR   M
        INR   M         Token +2 (#92)
        INX   H
        JMP   :E36D     Encode INT expr
*
********************************
* ENCODE 'DRAW', 'FILL', 'DOT' *
********************************
*
*EFILL
EDRAW   CALL  :E302     Encode <INT expr>,<INT expr>
 REM
* Entry for encode 'DOT':
 REM
EDOT    CALL  :E302     Idem
        JMP   :E314     Encode INT expr
*
***********************************
* ENCODE 'RUN' AND 'RUN <LINENR>' *
***********************************
*
ERUN    CALL  :E859     Next char ':' or 'CR' ?
        RZ              Then ready
 REM
* If 'RUN <linenr>':
 REM
        DCX   H
        INR   M         Token +1 (#88)
        INX   H
        JMP   :E72A     Get linenr into EBUF
*
****************
* ENCODE 'IMP' *
****************
*
* Note: This command is not encoded, but has
* immediate effect.
*
EIMP    PUSH  H
        LXI   H,:E2F1   Startaddr table var.types
        MVI   E,:00     1 info byte
        CALL  :CA34     Find type in table
        MOV   A,M       Get IMP type from table
        ORA   A
        JM    :DA0B     'SYNTAX ERROR' if not found
        PUSH  PSW       Preserve IMP type
        CPI   :20       STR type ?
        JZ    :E2B9     Then jump
        CALL  :E859     IMP INT/FPT alone ?
        JZ    :E2D9     Then ready
EIM10   CALL  :E2E6     Get char from line; check if
 REM upper case; INR C
        PUSH  PSW       Save char in IMP instruction
        CALL  :E867     Next char is '-' ?
        DATA  :2D
        CALL  :E2E6     Get next char from line;
 REM check if upper case; INR C
        LXI   H,:0234   Base addr IMP table
        MOV   D,H       ) into DE
        MOV   E,L       )
        CALL  :DE30     Calc offset end addr in HL
        INX   H         +1
        XCHG            In DE
        POP   PSW       Get char
        CALL  :DE30     Calc offset begin addr
        XCHG
        POP   PSW       Get IMP type
EIM20   CALL  :DE7C     Load given range with IMP
 REM type
        POP   H         Re-instate 'encoded' pntr
        RET
 REM
* If no range given:
 REM
L3E47   POP   PSW       Get IMP type
        STA   :028F     Store default number type
        LXI   D,:0275   Startaddr impl. type table
        LXI   H,:028F   Addr after end table
        JMP   :E2D4     Fill A-Z with reqd type
 REM
* Get character from line and check if it is a
* upper case character:
 REM
EALPHA  CALL  :DDD2     Get char from line, neglect
 REM tab + space
        CALL  :DE02     Check if upper case char
        JNC   :DA0B     Run 'SYNTAX ERROR' if not
        INR   C         Update textline pntr
        RET
*
* STRINGS VARIABLE TYPES TABLE:
*
* The first byte is a length byte. The byte
* after the string is the variable type byte.
*
IMPTT   DATA  :03
        DATA  :46       F
        DATA  :50       P
        DATA  :54       T
        DATA  :00       type is #00
*
        DATA  :03
        DATA  :49       I
        DATA  :4E       N
        DATA  :54       T
        DATA  :10       type is #10
*
        DATA  :03
        DATA  :53       S
        DATA  :54       T
        DATA  :52       R
        DATA  :20       type is #20
*
        DATA  :00       End of table
        DATA  :80
*
**********************************
* ENCODE 'POKE', 'OUT', 'CURSOR' *
**********************************
*
* Also used by: Encode 'DRAW' and 'FILL'.
*
*EPOKE
*EOUT
*ECURS
ENC3    CALL  :E36D     Encode INT expr
        CALL  :E862     Check if next char is ',';
 REM run error if not
        JMP   :E36D     Encode INT expression
*
*****************************
* ENCODE 'COLORG', 'COLORT' *
*****************************
*
* Partly also used to encode 'CLEAR' and 'TALK'.
*
* Exit: C, HL: updated.
*       AFDE preserved, B corrupted.
*
*ECOLT
ECOLG   CALL  :E36D     Encode INT expr
        CALL  :E36D     Idem
ENC6    CALL  :E36D     Idem
 REM
* Entry for encode CLEAR/TALK:
 REM
*ETALK
ECLEAR  JMP   :E36D     Idem
*
**************************************
* ENCODE 'SOUND' WITH POSSIBLE 'OFF' *
**************************************
*
* Encodes SOUND <CHAN><ENV><VOL><TG><FREQ>, or
* SOUND <CHAN> OFF or SOUND OFF.
*
* Exit: C, HL: Updated.
*       A preserved, B corrupted, D=0, E=1.
*       CY=1: Sound off.
*
ESOUND  CALL  :E32C     Encode a possible 'OFF'
        RC              Ready if 'OFF' given
        CALL  :E36D     Encode <CHAN>
        CALL  :E325     Encode 'OFF' or <ENV><VOL>
        RC              Ready if 'OFF' given
        JMP   :E311     Encode <TG><FREQ>
*
**************************************
* ENCODE 'NOISE' WITH POSSIBLE 'OFF' *
**************************************
*
* Encodes NOISE <ENV><VOL> or NOISE OFF.
*
* Exit: C, HL: Updated.
*       CY=1 : Noise off.
*       A preserved, B corrupted, D=0, E=1.
*
ENOISE  CALL  :E32C     Encode possible 'OFF'
        CNC   :E311     Encode <ENV><VOL> if no
 REM 'OFF' given
        RET
*
***************************
* ENCODE A POSSIBLE 'OFF' *
***************************
*
* Exit: CY=1:  'OFF' in input; FF in EBUF.
*       CY=0:  No 'OFF' given.
*       C, HL: Updated.
*       AB preserved, D=0, E=1.
*
L3E55   LXI   D,:E332   Startaddr table
        JMP   :E09A     Get addr encoding instr
 REM and go to it
 REM
* Table:
 REM
L3E404  DATA  :03
        DATA  :4F       O
        DATA  :46       F
        DATA  :46       F
        DBL   :E33B     addr encode 'OFF'
*
        DATA  :00
        DBL   :E342     encoding addr if no 'OFF'
 REM
* Encode 'OFF':
 REM
L3E365  MVI   M,:FF     FF into EBUF
        CALL  :E018     Update EBUF pointer
        STC             CY=1
        RET
 REM
* If no 'OFF':
 REM
L3E366  ORA   A         CY=0
        RET
*
******************
* ENCODE 'CALLM' *
******************
*
ECALM   CALL  :E36D     Encode memory addr (INT)
        MVI   M,:FF     FF into EBUF
        INX   H
        CALL  :E859     Next char ':' or 'CR' ?
        RZ              Then ready
        DCX   H
        CALL  :E862     Check if next char is ',';
 REM run error if not
        JMP   :E5BC     Encode var.pntr
*
*************************
* ENCODE 'SAVE', 'LOAD' *
*************************
*
* Checks if a name is given after 'SAVE/LOAD',
* then encodes a string. Else #19,#00 (empty
* unquoted string) is added to code.
*
* Exit: C,HL updated, AFB corrupted, DE preserved.
*
*ELOAD
ESAVE   CALL  :E859     Next char ':' or 'CR' ?
        JNZ   :E3A1     Encode string if not
        MVI   M,:19     #19 in next loc EBUF
        CALL  :E018     Update EBUF pointer
        MVI   M,:00     #00 in next loc EBUF
        CALL  :E018     Update EBUF pointer
        RET
*
**********************************
* ENCODE 'REM' AND '***' (ERROR) *
**********************************
*
*EERR
EREM    JMP   :E6B0     Encode text
*
**************************
* ENCODE SINGLE ROUTINES *
**************************
*
*EREST
*EEND
*ENEW
*ERET
*ECHECK
*ECONT
*ESTEP
*ETROF
*ESTOP
*ETRON
EUT     RET             No further handling
*
**************************
* ENCODE 'GOTO', 'GOSUB' *
**************************
*
*EGOTO
EGOSUB  JMP   :E72A     Get linenr
*
************************************************
* ENCODE AN EXPRESSION IF VARIABLE TYPE IS INT *
************************************************
*
L3E371  PUSH  D
        LXI   D,:0100   Set D=#01 (conversion) and
 REM E=#00 (FPT var type)
        MVI   B,:10     Reqd type is INT
        JMP   :E37C     Encode expression
*
************************************************
* ENCODE AN EXPRESSION IF VARIABLE TYPE IS FPT *
************************************************
*
L3E372  PUSH  D
        LXI   D,:0210   Set D for evt conversion
 REM and E=#10 (INT var type)
        MVI   B,:00     Reqd type is FPT
L3E373  PUSH  PSW
        MOV   A,B
        STA   :0290     Set reqd number type
        PUSH  H
        PUSH  D
        CALL  :E3C9     Encode expr
        POP   D
        LDA   :0136     Get type latest expression
        CMP   B         Was it as reqd ?
        JZ    :E398     Then ready
 REM
* Type not as expected:
 REM
        CMP   E         Was it alternative type
        JNZ   :DA1A     Run error 'TYPE MISMATCH'
 REM if not
        MOV   A,D       Get conversion byte in A
        POP   D
        PUSH  D
        CALL  :E770     Add conversion byte to expr
L3E374  POP   D
L3E375  POP   PSW
        POP   D
        RET
*
*******************************
* ENCODE A BOOLEAN EXPRESSION *
*******************************
*
* Variable type is #30.
*
L3E376  MVI   B,:30     Var type is #30
        JMP   :E3A3     Encode expression
*
******************************
* ENCODE A STRING EXPRESSION *
******************************
*
* Variable type is #20.
*
L3E377  MVI   B,:20     Var type is #20
 REM
* Entry for 'encode Boolean expression':
 REM
L3E378  PUSH  D
        PUSH  PSW
        CALL  :E3C9     Encode expr
        LDA   :0136     Get type latest expression
        CMP   B         Compare with reqd type
        JNZ   :DA1A     Run error 'TYPE MISMATCH'
 REM if not identical
        JMP   :E399     Quit
*
***********************************
* ENCODE A NON-BOOLEAN EXPRESSION *
***********************************
*
* Encodes an entire expression, preceeded by its
* type, into the EBUF. 'TYPE MISMATCH' error occurs
* if expression is boolean.
*
* Exit: C,HL updated; B preserved.
*       A: Type.      Type in TYPE.
*       D: Orig. B    OLDOP,RGTPT,HOPPT preserved.
*       E: OLDOP.
*
EEXPI   PUSH  H
        CALL  :E018     Update EBUF pointer
        XRA   A
        STA   :0290     Req. number type is #00
        CALL  :E3C9     Encode expr
        LDA   :0136     Get type latest expression
        CPI   :30       Boolean ?
        JZ    :DA1A     Then run error 'TYPE
 REM MISMATCH'
        XTHL            Get old EBUF pntr
        MOV   M,A       Type into EBUF
        POP   H         New EBUF pntr
        RET
*
************************
* ENCODE AN EXPRESSION *
************************
*
* Routine encodes an entire expression until no
* operator (or INOT) is found. The expression may
* begin with an unitary operator (highest priority).
*
* Exit: C,HL updated, B preserved.
*       A,E: OLDOP;   D: Entry B.
*       OLDOP, RGTPT, HOPPT preserved.
*       Type of expr in TYPE.
*       RGTOP: #00 or #1E.
*
L3E380  XCHG            Save HL in DE
        MOV   H,B       Var type in H
        LDA   :0138     Get old priority operator
        MOV   L,A       in L
        PUSH  H         Save it on stack
        LHLD  :0139     Get pntr place for operator
        PUSH  H         Save it on stack
        LHLD  :013B     Get pntr to RGT operand of
 REM last operator
        PUSH  H         Save it on stack
        XCHG
        XRA   A
        STA   :0138     Reset old prio operator
        CALL  :E3F1     Encode a term with possible
 REM unitary operator
        XCHG
        POP   H
        SHLD  :013B     Restore RGTPT
        POP   H
        SHLD  :0139     Restore HOPPT
        POP   H
        MOV   B,H       Restore B
        MOV   A,L
        STA   :0138     Restore OLDOP
        XCHG
        RET
*
*
*
        UNL
EGOTO   EQU EGOSUB
ETRON   EQU EUT
ESTOP   EQU EUT
ETROF   EQU EUT
ESTEP   EQU EUT
ECONT   EQU EUT
ECHECK  EQU EUT
ERET    EQU EUT
ENEW    EQU EUT
EEND    EQU EUT
EREST   EQU EUT
EERR    EQU EREM
ELOAD   EQU ESAVE
ETALK   EQU ECLEAR
ECOLT   EQU ECOLG
ECURS   EQU ENC3
EOUT    EQU ENC3
EPOKE   EQU ENC3
EFILL   EQU EDRAW
ELIST   EQU EEDIT
        LST
        END
